SIVAplot

Ce document prends comme paramètre la date du jour et la date du jour - 30 C’est une version de démo des fonctionnalités du package, et une exploration du code possible avant de faire le shiny

Les données seront chargées de 2022-11-16 à 2022-12-16

1 Plot des données de débit

#if (interactive()){
if (!exists("mainpass")) mainpass <- getPass::getPass(msg = "main password")
if (!exists("hostmysql")) {
  hostmysql. <- getPass::getPass(msg = "Saisir host")
  # ci dessous pour ne pas redemander au prochain tour
  hostmysql <- encrypt_string(string = hostmysql., key = mainpass)
} else {
  hostmysql. <- decrypt_string(string = hostmysql, key = mainpass)
}
if (!exists("pwdmysql")) {
  pwdmysql. <- getPass::getPass(msg = "Saisir password")
  pwdmysql <- encrypt_string(string = pwdmysql., key = mainpass)
}  else {
  # pass should be loaded
  pwdmysql. <- decrypt_string(string = pwdmysql, key = mainpass)
}
if (!exists("umysql")) {
  umysql. <- getPass::getPass(msg = "Saisir user")
  umysql <- encrypt_string(string = umysql., key = mainpass)
} else {
  umysql. <- decrypt_string(string = umysql, key = mainpass)
}
# attention il faut avaoir définit mainpass <- "xxxxx"

pool <- pool::dbPool(
  drv = RMariaDB::MariaDB(),
  dbname = "archive_IAV",
  host = hostmysql.,
  username = umysql.,
  password = pwdmysql.,
  port=3306
)


system.time(debit_barrage <-
              load_debit_barrage (debut = as.POSIXct(
                strptime("2018-01-01 00:00:00", format = "%Y-%m-%d %H:%M:%S")
              ),
              fin = as.POSIXct(
                strptime("2018-01-10 00:00:00", format = "%Y-%m-%d %H:%M:%S")
              ),
              con=pool))# 37-70 s maison # 10.5 EPTB
#> Table volet1(b_barrage_volet1_hauteur:2555), chargement de 1288 lignes 
#> Table volet2(b_barrage_volet2_hauteur:2556), chargement de 1288 lignes 
#> Table volet3(b_barrage_volet3_hauteur:2557), chargement de 1288 lignes 
#> Table volet4(b_barrage_volet4_hauteur:2558), chargement de 1288 lignes 
#> Table volet5(b_barrage_volet5_hauteur:2559), chargement de 1288 lignes 
#> Table vanne1(b_barrage_vanne1_hauteur:2509), chargement de 1288 lignes 
#> Table vanne2(b_barrage_vanne2_hauteur:2510), chargement de 1288 lignes 
#> Table vanne3(b_barrage_vanne3_hauteur:2511), chargement de 1288 lignes 
#> Table vanne4(b_barrage_vanne4_hauteur:2512), chargement de 1288 lignes 
#> Table vanne5(b_barrage_vanne5_hauteur:2513), chargement de 1288 lignes 
#> Table debit_vilaine_estime(b_barrage_debit:2515), chargement de 1288 lignes 
#> Table debit_passe(b_barrage_debit:2523), chargement de 1288 lignes 
#> Table debit_moyen_cran(b_pont_de_cran_debit:1900), chargement de 1288 lignes 
#> Table tot_vol_barrage(b_barrage_volume:2550), chargement de 1288 lignes 
#> Table tot_vol_passe(b_barrage_volume:2551), chargement de 1288 lignes 
#> Table tot_vol_siphon(b_barrage_volume:2552), chargement de 1288 lignes 
#> Table tot_vol_volet(b_barrage_volume:2553), chargement de 1288 lignes 
#> Table tot_vol_ecluse(b_barrage_volume:2554), chargement de 1288 lignes 
#> Table niveauvilaine(b_passeapoisson_niveauvilaine:2519), chargement de 1288 lignes 
#> Table niveaumer(b_passeapoisson_niveaumer:2520), chargement de 1288 lignes 
#> Table niveauvilaineb(b_barrage_niveau:2507), chargement de 1288 lignes 
#> Table niveaumerb(b_barrage_niveau:2508), chargement de 1288 lignes 
#> Table debit_siphon_1(b_siphon_debit:1528), chargement de 1288 lignes 
#> Table debit_siphon_2(b_siphon_debit:1565), chargement de 1288 lignes 
#> Table debit_vanne1(b_barrage_debit:2571), chargement de 1288 lignes 
#> Table debit_vanne2(b_barrage_debit:2572), chargement de 1288 lignes 
#> Table debit_vanne3(b_barrage_debit:2573), chargement de 1288 lignes 
#> Table debit_vanne4(b_barrage_debit:2574), chargement de 1288 lignes 
#> Table debit_vanne5(b_barrage_debit:2575), chargement de 1287 lignes 
#> Table debit_volet1(b_barrage_debit:2581), chargement de 1288 lignes 
#> Table debit_volet2(b_barrage_debit:2582), chargement de 1288 lignes 
#> Table debit_volet3(b_barrage_debit:2583), chargement de 1288 lignes 
#> Table debit_volet4(b_barrage_debit:2584), chargement de 1288 lignes 
#> Table debit_volet5(b_barrage_debit:2585), chargement de 1288 lignes 
#> fin des calculs
#> utilisateur     système      écoulé 
#>        0.36        0.01        3.41
#} # end if interactive

debit_barrage <-traitement_siva(debit_barrage)

#pool:poolClose(pool)

# chargement des paramètres du barrage
#load(system.file("param2012_2014.Rdata", package = "SIVA"))
Q12345 <- debit_total(param, param0 = param, debit_barrage)
Q12345$tot_vol <- debit_barrage$tot_vol # volume total au barrage d'Arzal

Q12345$volet_vanne <-
  rowSums(debit_barrage[,c("tot_vol_barrage","tot_vol_volet")], na.rm=TRUE) # volume total toutes les dix minutes sur volets et vannes
mQ <-
  reshape2::melt(
    Q12345[, c("horodate",
               "qvanne1",
               "qvanne2",
               "qvanne3",
               "qvanne4",
               "qvanne5")],
    id.vars = "horodate",
    value.name = "Qvanne",
    variable.name = "vanne"
  )
mcond <-
  reshape2::melt(Q12345[, c("horodate",
                            "typecalc1",
                            "typecalc2",
                            "typecalc3",
                            "typecalc4",
                            "typecalc5")], value.name = "typecalc", id.vars = "horodate")
mQ$vanne <- as.character(mQ$vanne)
mQ$vanne <- gsub("qvanne", "", mQ$vanne)
mQ12345 <- cbind(mQ, "typecalc" = mcond[, 3]) # melted object


g <-ggplot2::ggplot(mQ12345, ggplot2::aes(
  x = horodate,
  y = Qvanne,
  col = typecalc,
  shape = vanne
)) + ggplot2::geom_jitter(size = 0.6)

print(g)

# Calcul du débit journalier
Qj <-
  as.data.frame(
    Q12345 %>%dplyr::select(
      Q,
      date,
      volvoletcalcule,
      debit_moyen_cran,
      tot_vol,
      volet_vanne,
      tot_vol_siphon,
      tot_vol_passe,
      tot_vol_ecluse
    ) %>%
      dplyr::group_by(date) %>%
      dplyr::summarize(
        vol_recalc = 
          sum(Q * 600, volvoletcalcule, tot_vol_passe, tot_vol_siphon,
              tot_vol_ecluse, na.rm =TRUE),
        vol_bar = sum(tot_vol, na.rm = TRUE),
        vol_passe = sum(tot_vol_passe, na.rm = TRUE),
        vol_ecluse = sum(tot_vol_ecluse, na.rm = TRUE),
        vol_siphon = sum(tot_vol_siphon, na.rm = TRUE),
        vol_volet_vanne_bar = sum(volet_vanne),
        debit_moyen_cran = mean(debit_moyen_cran),
        debit_moyen_recalcule = mean(Q, na.rm=TRUE)
        
      ) %>%
      dplyr::mutate(
        debit_moyen_vol_recalc = vol_recalc / (24 * 60 * 60),
        debit_moyen_vol_bar = vol_bar / (24 * 60 * 60),
        debit_moyen_volet_vanne_bar = vol_volet_vanne_bar / (24 * 60 * 60)
      )
  )
Qj <- Qj %>% 
  mutate(across(starts_with("vol"), round)) %>%
  mutate(across(starts_with("debit"),  ~ round(.x,digits=3))) %>%
  arrange(date) %>%
  slice(-1)

knitr::kable(Qj)

date	vol_recalc	vol_bar	vol_passe	vol_ecluse	vol_siphon	vol_volet_vanne_bar	debit_moyen_cran	debit_moyen_recalcule	debit_moyen_vol_recalc	debit_moyen_vol_bar	debit_moyen_volet_vanne_bar
2018-01-02	15050847	15181559	0	71	0	724080	187.798	173.804	174.200	175.712	8.381
2018-01-03	18571832	18445715	0	627	0	196736	221.906	216.448	214.952	213.492	2.277
2018-01-04	16661476	17027392	0	0	0	216384	213.000	194.190	192.841	197.076	2.504
2018-01-05	15210149	15290574	0	462	0	285056	206.431	177.269	176.043	176.974	3.299
2018-01-06	17761908	17962306	0	2722	0	275520	209.813	206.984	205.578	207.897	3.189
2018-01-07	17919896	18192096	0	0	0	664320	200.165	207.406	207.406	210.557	7.689
2018-01-08	14035618	14263072	0	0	0	1128384	179.404	163.585	162.449	165.082	13.060
2018-01-09	13665025	14002056	0	120	0	2929744	162.133	146.861	158.160	162.061	33.909

Le barrage renvoit des volumes vannes, volet, écluse, passe et siphons. Les volumes sont recalculés par les fonctions de calcul debit_total. On a dans l’ordre :

Les recalculs qui sont OK :

• debit_moyen_cran Le débit moyen à Cran

• Débit_moyen_recalculé = Débit recaculé vannes et volets + volumes :

\[ Q = \sum_{t}(vol/86400)=\sum_t \frac{\sum_{i=1}^5 \beta Q_{va}(t,i)+\sum_{i=1}^5 \beta Q_{vo}(t,i)+V_{s}(t)+V_{p}(t)+V_{e}(t)}{86400} \]

Avec

\(V_s\)= volume siphon

\(V_p\)=volume passe

\(V_e\)=volume écluse

\(\beta\)=600

• Debit_moy_vol_recalc : presque identique au précédent, au lieu de la moyenne des débits, on calcule la somme du volume et on ramène à 86400

• Débit moyen vol_bar : en partant des totaliseurs de volume au barrage, qui sont pourris, on calcule un débit journalier.

• Débit moyen vanne_bar : Somme des totaliseurs de volumes volets et vannes sur le barrage, qui sont ramenés à des débits. C’est de là que le problème vient.

Qj %>% select(date|  starts_with("debit")) %>% 
  pivot_longer(cols=starts_with("debit"),names_to = "source",values_to = "Q") %>%
  ggplot() + geom_point(aes(x=date,y=Q, col=source)) +
  geom_line(aes(x=date,y=Q, col=source))

2 Graphiques de niveaux

Il s’agit juste de tester les fonctions ggplotly utilisées plus tard dans le shiny.

niveaux <- debit_barrage %>% select(horodate, niveauvilaineb,
                                    niveaumerb) %>%
  rename(horodate = horodate) %>% # todo get rid of horodate in code
  pivot_longer(
    cols = c("niveauvilaineb", "niveaumerb"),
    names_to = "source",
    names_prefix = "niveau",
    values_to = "niveau"
  )
debits_vannes <-
  Q12345 %>% select(horodate, starts_with("Qvanne")) %>%
  pivot_longer(
    cols = starts_with("Qvanne"),
    names_to = "vanne",
    names_prefix = "qvanne",
    values_to = "Q"
  )
debits_volets <-
  Q12345 %>% select(horodate, starts_with("Qvolet")) %>%
  pivot_longer(
    cols = starts_with("Qvolet"),
    names_to = "volet",
    names_prefix = "Qvolet",
    values_to = "Q"
  )


g1 <- ggplot()+ geom_line(aes(x=horodate, y=niveau, col=source), data=niveaux) 
g2 <- ggplot()+  geom_line(aes(x=horodate, y=Q, col=vanne), data=debits_vannes)+ 
  geom_line(aes(x=horodate, y=Q, col=volet), data=debits_volets)
plotly::ggplotly(g1)

plotly::ggplotly(g2)

niveaux%>% plotly::plot_ly( x= ~horodate, y= ~niveau) %>% plotly:: add_lines( color = ~source, colors = "Set1") %>% plotly:: add_markers( color = ~source, colors = "Set1")

2.1 graphes crosstalk

Le crosstalk ne marche pas sur les gros jeux de données => éviter dans le shiny

library(crosstalk)
niveaux <- debit_barrage %>% select(horodate, niveauvilaineb,
                                    niveaumerb) %>%
  rename(horodate = horodate) %>% # todo get rid of horodate in code
  pivot_longer(
    cols = c("niveauvilaineb", "niveaumerb"),
    names_to = "source",
    names_prefix = "niveau",
    values_to = "valeur"
  )
niveaux <- debit_barrage %>% select(horodate, niveauvilaineb,
                                    niveaumerb) %>%
  rename(horodate = horodate) %>% # todo get rid of horodate in code
  pivot_longer(
    cols = c("niveauvilaineb", "niveaumerb"),
    names_to = "source",
    names_prefix = "niveau",
    values_to = "niveau"
  )
debits_vannes <-
  Q12345 %>% select(horodate, starts_with("Qvanne")) %>%
  pivot_longer(
    cols = starts_with("Qvanne"),
    names_to = "vanne",
    names_prefix = "qvanne",
    values_to = "Q"
  )
debits_volets <-
  Q12345 %>% select(horodate, starts_with("Qvolet")) %>%
  pivot_longer(
    cols = starts_with("Qvolet"),
    names_to = "volet",
    names_prefix = "Qvolet",
    values_to = "Q"
  )
total <- dplyr::inner_join(niveaux, dplyr::inner_join(debits_vannes, debits_volets))
shared_total <- SharedData$new(total)
g1 <- ggplot()+ geom_point(aes(x=horodate, y=niveau, col=source), data=shared_total) 
g2 <- ggplot()+  geom_point(aes(x=horodate, y=Q, col=vanne), data=shared_total)+ 
  geom_point(aes(x=horodate, y=Q, col=volet), data=shared_total)
bscols(
  plotly::ggplotly(g1),
  plotly::ggplotly(g2))

3 graphes RmaChart

C’est ce qui est utilisé dans le SIVA actuel.

#install.packages("rAmCharts")
library("rAmCharts")
#> Full amcharts.js API available using amChartsAPI()
#> Look at rAmCharts::runExamples() & https://datastorm-open.github.io/introduction_ramcharts/
#> Bug report or feed back on https://github.com/datastorm-open/rAmCharts
debit_barrage %>% 
  amTimeSeries(
    'horodate',
    c("niveaumerb", "niveauvilaineb"),
    bullet = c("round", "square"),
    color = col <-
      c("orange", "limegreen"),
    #"yellow","#39CCCC")
    backgroundColor = "#40555E",
    backgroundAlpha = 0.4,
    bulletSize = c(6, 4),
    aggregation = "Average",
    fillAlphas = c(0.1, 0.1),
    groupToPeriods = c('10mm', '30mm', 'hh', 'DD', 'MM', 'MAX'),
    #  c('hh', 'DD', '10DD','MM','MAX'),
    linewidth = c(0.2, 0.2),
    legend = TRUE,
    # maxSeries = 200,
    categoryAxesSettings.minPeriod = "30mm"
  ) %>%
  setExport(enabled = TRUE)   
#> Warning in controlgroupToPeriods(groupToPeriods, difft): NAs introduits lors de
#> la conversion automatique

4 traitement des données de niveau

Ici on a un exemple, il suffit de passer les tag pour utiliser la fonction.

if (!exists("mainpass")) mainpass <- getPass::getPass(msg = "main password")
if (!exists("hostmysql")) {
  hostmysql. <- getPass::getPass(msg = "Saisir host")
  # ci dessous pour ne pas redemander au prochain tour
  hostmysql <- encrypt_string(string = hostmysql., key = mainpass)
} else {
  hostmysql. <- decrypt_string(string = hostmysql, key = mainpass)
}
if (!exists("pwdmysql")) {
  pwdmysql. <- getPass::getPass(msg = "Saisir password")
  pwdmysql <- encrypt_string(string = pwdmysql., key = mainpass)
}  else {
  # pass should be loaded
  pwdmysql. <- decrypt_string(string = pwdmysql, key = mainpass)
}
if (!exists("umysql")) {
  umysql. <- getPass::getPass(msg = "Saisir user")
  umysql <- encrypt_string(string = umysql., key = mainpass)
} else {
  umysql. <- decrypt_string(string = umysql, key = mainpass)
}
# attention il faut avaoir définit mainpass <- "xxxxx"

pool <- pool::dbPool(
  drv = RMariaDB::MariaDB(),
  dbname = "archive_IAV",
  host = hostmysql.,
  username = umysql.,
  password = pwdmysql.,
  port=3306
)



niveaux2 <-
  load_niveaux(
    debut = as.POSIXct(strptime("2021-01-01 00:00:00",
                                format = "%Y-%m-%d %H:%M:%S")),
    fin = as.POSIXct(strptime("2021-01-10 00:00:00",
                              format = "%Y-%m-%d %H:%M:%S")),
    tags = c(2507, 2508, 2100, 1000, 
             1100,1300,1400,1902,2000),
    con = pool
  )
#> Table vilaine_barrage(b_barrage_niveau:2507), chargement de 1291 lignes 
#> Table mer_barrage(b_barrage_niveau:2508), chargement de 1291 lignes 
#> Table redon_ecluse(b_redonecluse_niveau:2100), chargement de 1290 lignes 
#> Table aucfer(b_aucfer_niveau:1000), chargement de 1290 lignes 
#> Table molac(b_molac_niveau:1100), chargement de 1290 lignes 
#> Table legueslin(b_legueslin_niveau:1300), chargement de 1290 lignes 
#> Table sixtsuraff(b_sixtsuraff_niveau:1400), chargement de 1290 lignes 
#> Table pontdecran(b_pont_de_cran_niveau:1902), chargement de 1239 lignes 
#> Table guerouet(b_guenrouet_niveau:2000), chargement de 275 lignes 
#> fin des calculs

poolClose(pool)

#install.packages("rAmCharts")


library("rAmCharts")
niveaux2 %>%
  rAmCharts::amTimeSeries(
    'horodate',
    c("vilaine_barrage",
      "mer_barrage",
      "redon_ecluse",
      "aucfer",
      "molac",
      "legueslin",
      "sixtsuraff",
      "pontdecran",
      "guerouet"
    ),
    bullet = "round",
    color =   randomcoloR::distinctColorPalette(9),
    #backgroundColor = "#40555E",
    #backgroundAlpha = 0.4,
    bulletSize =  4,
    aggregation = "Average",
    fillAlphas = 0.1,
    groupToPeriods = c('10mm', '30mm', 'hh', 'DD', 'MM', 'MAX'),
    #  c('hh', 'DD', '10DD','MM','MAX'),
    linewidth = 0.2,
    legend = TRUE,
    # maxSeries = 200,
    categoryAxesSettings.minPeriod = "30mm"
  ) %>%
  setExport(enabled = TRUE)   
#> Warning in controlgroupToPeriods(groupToPeriods, difft): NAs introduits lors de
#> la conversion automatique